(defvar *semlex*)

(setq *semlex*
      (make-hash-table :size 100 :test #'equal))

(defun load-semantics (file)
  (let (form old)
    (clrhash *semlex*)
    (with-open-file (in file :direction :input)
      (loop
       (setq form (read in nil in))
       (when (eq form in)
         (return))
       (format t "~%SEMLEX: ~s" form)
       (setq old (gethash (first form) *semlex*))
       (if old
           (warn "Duplicate definition for ~s ignored!"
                 (first form))
           (setf (gethash (first form) *semlex*)
                 form))))))

(load-semantics "F:/class/NLPLab/workspace/nlp-lab/glr/glr-semantics.lisp")

;------------------------------------------------------------

(defun get-n-pair (frame)
  (second (get-entry (second (second frame))))
  )

(defun get-v-pair (frame)
  (second frame)
  )

(defun semrole-filler-match (head-frame role filler-frame pos &aux head-pair filler-pair)
  (setf head-pair (case pos (N (get-n-pair head-frame)) (V (get-v-pair head-frame))))
  (setf filler-pair (get-n-pair filler-frame))
  
  (and
   (and
    (equal role (first head-pair))
    (equal role (first filler-pair)))
   (equal (second head-pair) (second filler-pair))))
  
;------------------------------------------------------------

(defun get-role (fs role)
  (dolist (f fs nil)
    (when (equal (first f) role)
      (return (second f)))))

(defun get-entry (sem)
  (gethash sem *semlex*))

(defun license-attachment (head filler &aux pos head-sem filler-sem head-frame role filler-frame license)
  
  (setf pos (get-role head 'cat))
  (setf head-sem (get-role head 'sem))
  (setf role (get-role filler 'semrole))
  (setf filler-sem (get-role (get-role filler 'obj) 'sem))
   
  (setf head-frame (get-entry head-sem))
  (setf filler-frame (get-entry filler-sem))
  
  (setf license
        (if (equal (first role) '*OR*)
            (dolist (rl (rest role) nil)
              (when (semrole-filler-match head-frame rl filler-frame pos)
                (setf role rl)
                (return t)))
            (semrole-filler-match head-frame role filler-frame pos)))
  
  (print (append (if license (list '** 'ATTACHING) (list '** 'ATTACH 'FAILED)) 
                 (list "(" head-sem "(" role filler-sem "))")))
  
  license)
